home *** CD-ROM | disk | FTP | other *** search
Text File | 1995-03-23 | 19.6 KB | 520 lines | [TEXT/ROSA] |
-
- Appendix C.
- Backquote
-
- [change_begin]
- Here is the code for an implementation of backquote syntax (see section 22.1.3)
- that I have found quite useful in explaining to myself the behavior of nested
- backquotes. It implements the formal rules for backquote processing and
- optionally applies a code simplifier to the result. One must be very careful in
- choosing the simplification rules; the rules given here work, but some Common
- Lisp implementations have run into trouble at one time or another by using a
- simplification rule that does not work in all cases. Code transformations that
- are plausible when single forms are involved are likely to fail in the presence
- of splicing.
-
- At the end of this appendix are some samples of nested backquote syntax with
- commentary.
-
- ;;; Common Lisp backquote implementation, written in Common Lisp.
- ;;; Author: Guy L. Steele Jr. Date: 27 December 1985
- ;;; Tested under Symbolics Common Lisp and Lucid Common Lisp.
- ;;; This software is in the public domain.
-
- ;;; $ is pseudo-backquote and % is pseudo-comma. This makes it
- ;;; possible to test this code without interfering with normal
- ;;; Common Lisp syntax.
-
- ;;; The following are unique tokens used during processing.
- ;;; They need not be symbols; they need not even be atoms.
-
- (defvar *comma* (make-symbol "COMMA"))
- (defvar *comma-atsign* (make-symbol "COMMA-ATSIGN"))
- (defvar *comma-dot* (make-symbol "COMMA-DOT"))
- (defvar *bq-list* (make-symbol "BQ-LIST"))
- (defvar *bq-append* (make-symbol "BQ-APPEND"))
- (defvar *bq-list** (make-symbol "BQ-LIST*"))
- (defvar *bq-nconc* (make-symbol "BQ-NCONC"))
- (defvar *bq-clobberable* (make-symbol "BQ-CLOBBERABLE"))
- (defvar *bq-quote* (make-symbol "BQ-QUOTE"))
- (defvar *bq-quote-nil* (list *bq-quote* nil))
-
- ;;; Reader macro characters:
- ;;; $foo is read in as (BACKQUOTE foo)
- ;;; %foo is read in as (#:COMMA foo)
- ;;; %@foo is read in as (#:COMMA-ATSIGN foo)
- ;;; %.foo is read in as (#:COMMA-DOT foo)
- ;;; where #:COMMA is the value of the variable *COMMA*, etc.
-
- ;;; BACKQUOTE is an ordinary macro (not a read-macro) that
- ;;; processes the expression foo, looking for occurrences of
- ;;; #:COMMA, #:COMMA-ATSIGN, and #:COMMA-DOT. It constructs code
- ;;; in strict accordance with the rules on pages 349-350 of
- ;;; the first edition (pages 528-529 of this second edition).
- ;;; It then optionally applies a code simplifier.
-
- (set-macro-character #\$
- #'(lambda (stream char)
- (declare (ignore char))
- (list 'backquote (read stream t nil t))))
-
- (set-macro-character #\%
- #'(lambda (stream char)
- (declare (ignore char))
- (case (peek-char nil stream t nil t)
- (#\@ (read-char stream t nil t)
- (list *comma-atsign* (read stream t nil t)))
- (#\. (read-char stream t nil t)
- (list *comma-dot* (read stream t nil t)))
- (otherwise (list *comma* (read stream t nil t))))))
-
-
- ;;; If the value of *BQ-SIMPLIFY* is non-NIL, then BACKQUOTE
- ;;; processing applies the code simplifier. If the value is NIL,
- ;;; then the code resulting from BACKQUOTE is exactly that
- ;;; specified by the official rules.
-
- (defparameter *bq-simplify* t)
-
- (defmacro backquote (x)
- (bq-completely-process x))
-
- ;;; Backquote processing proceeds in three stages:
- ;;;
- ;;; (1) BQ-PROCESS applies the rules to remove occurrences of
- ;;; #:COMMA, #:COMMA-ATSIGN, and #:COMMA-DOT corresponding to
- ;;; this level of BACKQUOTE. (It also causes embedded calls to
- ;;; BACKQUOTE to be expanded so that nesting is properly handled.)
- ;;; Code is produced that is expressed in terms of functions
- ;;; #:BQ-LIST, #:BQ-APPEND, and #:BQ-CLOBBERABLE. This is done
- ;;; so that the simplifier will simplify only list construction
- ;;; functions actually generated by BACKQUOTE and will not involve
- ;;; any user code in the simplification. #:BQ-LIST means LIST,
- ;;; #:BQ-APPEND means APPEND, and #:BQ-CLOBBERABLE means IDENTITY
- ;;; but indicates places where "%." was used and where NCONC may
- ;;; therefore be introduced by the simplifier for efficiency.
- ;;;
- ;;; (2) BQ-SIMPLIFY, if used, rewrites the code produced by
- ;;; BQ-PROCESS to produce equivalent but faster code. The
- ;;; additional functions #:BQ-LIST* and #:BQ-NCONC may be
- ;;; introduced into the code.
- ;;;
- ;;; (3) BQ-REMOVE-TOKENS goes through the code and replaces
- ;;; #:BQ-LIST with LIST, #:BQ-APPEND with APPEND, and so on.
- ;;; #:BQ-CLOBBERABLE is simply eliminated (a call to it being
- ;;; replaced by its argument). #:BQ-LIST* is replaced by either
- ;;; LIST* or CONS (the latter is used in the two-argument case,
- ;;; purely to make the resulting code a tad more readable).
-
- (defun bq-completely-process (x)
- (let ((raw-result (bq-process x)))
- (bq-remove-tokens (if *bq-simplify*
- (bq-simplify raw-result)
- raw-result))))
-
- (defun bq-process (x)
- (cond ((atom x)
- (list *bq-quote* x))
- ((eq (car x) 'backquote)
- (bq-process (bq-completely-process (cadr x))))
- ((eq (car x) *comma*) (cadr x))
- ((eq (car x) *comma-atsign*)
- (error ",@~S after `" (cadr x)))
- ((eq (car x) *comma-dot*)
- (error ",.~S after `" (cadr x)))
- (t (do ((p x (cdr p))
- (q '() (cons (bracket (car p)) q)))
- ((atom p)
- (cons *bq-append*
- (nreconc q (list (list *bq-quote* p)))))
- (when (eq (car p) *comma*)
- (unless (null (cddr p)) (error "Malformed ,~S" p))
- (return (cons *bq-append*
- (nreconc q (list (cadr p))))))
- (when (eq (car p) *comma-atsign*)
- (error "Dotted ,@~S" p))
- (when (eq (car p) *comma-dot*)
- (error "Dotted ,.~S" p))))))
-
- ;;; This implements the bracket operator of the formal rules.
-
- (defun bracket (x)
- (cond ((atom x)
- (list *bq-list* (bq-process x)))
- ((eq (car x) *comma*)
- (list *bq-list* (cadr x)))
- ((eq (car x) *comma-atsign*)
- (cadr x))
- ((eq (car x) *comma-dot*)
- (list *bq-clobberable* (cadr x)))
- (t (list *bq-list* (bq-process x)))))
-
- ;;; This auxiliary function is like MAPCAR but has two extra
- ;;; purposes: (1) it handles dotted lists; (2) it tries to make
- ;;; the result share with the argument x as much as possible.
-
- (defun maptree (fn x)
- (if (atom x)
- (funcall fn x)
- (let ((a (funcall fn (car x)))
- (d (maptree fn (cdr x))))
- (if (and (eql a (car x)) (eql d (cdr x)))
- x
- (cons a d)))))
-
- ;;; This predicate is true of a form that when read looked
- ;;; like %@foo or %.foo.
-
- (defun bq-splicing-frob (x)
- (and (consp x)
- (or (eq (car x) *comma-atsign*)
- (eq (car x) *comma-dot*))))
-
-
- ;;; This predicate is true of a form that when read
- ;;; looked like %@foo or %.foo or just plain %foo.
-
- (defun bq-frob (x)
- (and (consp x)
- (or (eq (car x) *comma*)
- (eq (car x) *comma-atsign*)
- (eq (car x) *comma-dot*))))
-
- ;;; The simplifier essentially looks for calls to #:BQ-APPEND and
- ;;; tries to simplify them. The arguments to #:BQ-APPEND are
- ;;; processed from right to left, building up a replacement form.
- ;;; At each step a number of special cases are handled that,
- ;;; loosely speaking, look like this:
- ;;;
- ;;; (APPEND (LIST a b c) foo) => (LIST* a b c foo)
- ;;; provided a, b, c are not splicing frobs
- ;;; (APPEND (LIST* a b c) foo) => (LIST* a b (APPEND c foo))
- ;;; provided a, b, c are not splicing frobs
- ;;; (APPEND (QUOTE (x)) foo) => (LIST* (QUOTE x) foo)
- ;;; (APPEND (CLOBBERABLE x) foo) => (NCONC x foo)
-
- (defun bq-simplify (x)
- (if (atom x)
- x
- (let ((x (if (eq (car x) *bq-quote*)
- x
- (maptree #'bq-simplify x))))
- (if (not (eq (car x) *bq-append*))
- x
- (bq-simplify-args x)))))
-
- (defun bq-simplify-args (x)
- (do ((args (reverse (cdr x)) (cdr args))
- (result
- nil
- (cond ((atom (car args))
- (bq-attach-append *bq-append* (car args) result))
- ((and (eq (caar args) *bq-list*)
- (notany #'bq-splicing-frob (cdar args)))
- (bq-attach-conses (cdar args) result))
- ((and (eq (caar args) *bq-list**)
- (notany #'bq-splicing-frob (cdar args)))
- (bq-attach-conses
- (reverse (cdr (reverse (cdar args))))
- (bq-attach-append *bq-append*
- (car (last (car args)))
- result)))
- ((and (eq (caar args) *bq-quote*)
- (consp (cadar args))
- (not (bq-frob (cadar args)))
- (null (cddar args)))
- (bq-attach-conses (list (list *bq-quote*
- (caadar args)))
- result))
- ((eq (caar args) *bq-clobberable*)
- (bq-attach-append *bq-nconc* (cadar args) result))
- (t (bq-attach-append *bq-append*
- (car args)
- result)))))
- ((null args) result)))
-
- (defun null-or-quoted (x)
- (or (null x) (and (consp x) (eq (car x) *bq-quote*))))
-
- ;;; When BQ-ATTACH-APPEND is called, the OP should be #:BQ-APPEND
- ;;; or #:BQ-NCONC. This produces a form (op item result) but
- ;;; some simplifications are done on the fly:
- ;;;
- ;;; (op '(a b c) '(d e f g)) => '(a b c d e f g)
- ;;; (op item 'nil) => item, provided item is not a splicable frob
- ;;; (op item 'nil) => (op item), if item is a splicable frob
- ;;; (op item (op a b c)) => (op item a b c)
-
- (defun bq-attach-append (op item result)
- (cond ((and (null-or-quoted item) (null-or-quoted result))
- (list *bq-quote* (append (cadr item) (cadr result))))
- ((or (null result) (equal result *bq-quote-nil*))
- (if (bq-splicing-frob item) (list op item) item))
- ((and (consp result) (eq (car result) op))
- (list* (car result) item (cdr result)))
- (t (list op item result))))
-
- ;;; The effect of BQ-ATTACH-CONSES is to produce a form as if by
- ;;; `(LIST* ,@items ,result) but some simplifications are done
- ;;; on the fly.
- ;;;
- ;;; (LIST* 'a 'b 'c 'd) => '(a b c . d)
- ;;; (LIST* a b c 'nil) => (LIST a b c)
- ;;; (LIST* a b c (LIST* d e f g)) => (LIST* a b c d e f g)
- ;;; (LIST* a b c (LIST d e f g)) => (LIST a b c d e f g)
-
- (defun bq-attach-conses (items result)
- (cond ((and (every #'null-or-quoted items)
- (null-or-quoted result))
- (list *bq-quote*
- (append (mapcar #'cadr items) (cadr result))))
- ((or (null result) (equal result *bq-quote-nil*))
- (cons *bq-list* items))
- ((and (consp result)
- (or (eq (car result) *bq-list*)
- (eq (car result) *bq-list**)))
- (cons (car result) (append items (cdr result))))
- (t (cons *bq-list** (append items (list result))))))
-
- ;;; Removes funny tokens and changes (#:BQ-LIST* a b) into
- ;;; (CONS a b) instead of (LIST* a b), purely for readability.
-
- (defun bq-remove-tokens (x)
- (cond ((eq x *bq-list*) 'list)
- ((eq x *bq-append*) 'append)
- ((eq x *bq-nconc*) 'nconc)
- ((eq x *bq-list**) 'list*)
- ((eq x *bq-quote*) 'quote)
- ((atom x) x)
- ((eq (car x) *bq-clobberable*)
- (bq-remove-tokens (cadr x)))
- ((and (eq (car x) *bq-list**)
- (consp (cddr x))
- (null (cdddr x)))
- (cons 'cons (maptree #'bq-remove-tokens (cdr x))))
- (t (maptree #'bq-remove-tokens x))))
-
- Suppose that we first make the following definitions:
-
- (setq q '(r s))
- (defun r (x) (reduce #'* x))
- (setq r '(3 5))
- (setq s '(4 6))
-
- Without simplification, the notation $$(%%q) (which stands for ``(,,q)) is read
- as the expression
-
- (APPEND (LIST 'APPEND) (LIST (APPEND (LIST 'LIST) (LIST Q))))
-
- The value of this expression is
-
- (APPEND (LIST (R S)))
-
- and the value of this value is (24). We conclude that the net effect of
- twice-evaluating ``(,,q) is to take the value 24 of the value (r s) of q and
- plug it into the template ( ) to produce (24).
-
- With simplification, the notation $$(%%q) is read as the expression
-
- (LIST 'LIST Q)
-
- The value of this expression is
-
- (LIST (R S))
-
- and the value of this value is (24). Thus the two ways of reading $$(%%q) do
- not produce the same expression-this we expected-but the values of the two ways
- are different as well. Only the values of the values are the same. In general,
- Common Lisp guarantees the result of an expression with backquotes nested to
- depth k only after k successive evaluations have been performed; the results
- after fewer than k evaluations are implementation-dependent.
-
- (Note that in the expression `(foo ,(process `(bar ,x))) the backquotes are not
- doubly nested. The inner backquoted expression occurs within the textual scope
- of a comma belonging to the outer backquote. The correct way to determine the
- backquote nesting level of any subexpression is to start a count at zero and
- proceed up the S-expression tree, adding one for each backquote and subtracting
- one for each comma. This is similar to the rule for determining nesting level
- with respect to parentheses by scanning a character string linearly, adding or
- subtracting one as parentheses are passed.)
-
- It is convenient to extend the ``=='' notation to handle multiple evaluation: x
- == == y means that the expressions x and y may have different results but they
- have the same results when twice evaluated. Similarly, x == ==== y means that
- the values of the values of the values of x and y are the same, and so on.
-
- We can illustrate the differences between non-splicing and splicing backquote
- inclusions quite concisely:
-
- $$(%%q) ==
- (APPEND (LIST 'APPEND) (LIST (APPEND (LIST 'LIST) (LIST Q))))
- == == (LIST 'LIST Q) => (LIST (R S)) => (24)
-
- $$(%@%q) ==
- (APPEND (LIST 'APPEND) (LIST Q))
- == == Q => (R S) => 24
-
- $$(%%@q) ==
- (APPEND (LIST 'APPEND) (LIST (APPEND (LIST 'LIST) Q)))
- == == (CONS 'LIST Q) => (LIST R S) => ((3 5) (4 6))
-
- $$(%@%@q) ==
- (APPEND (LIST 'APPEND) Q)
- == == (CONS 'APPEND Q) => (APPEND R S) => (3 5 4 6)
-
- In each case I have shown both the unsimplified and simplified forms and then
- traced the intermediate evaluations of the simplified form. (Actually, the
- unsimplified forms do contain one simplification without which they would be
- unreadable: the nil that terminates each list has been systematically
- suppressed, so that one sees (append x y) rather than (append x y 'nil).)
-
- The following driver function is useful for tracing the behavior of nested
- backquote syntax through multiple evaluations. The argument ls is a list of
- strings; each string will be processed by the reader (read-from-string). The
- argument n is the number of evaluations desired.
-
- (defun try (ls &optional (n 0))
- (dolist (x ls)
- (format t "~&~A"
- (substitute #\` #\$ (substitute #\, #\% x)))
- (do ((form (macroexpand (read-from-string x)) (eval form))
- (str " = " "~% => ")
- (j 0 (+ j 1)))
- ((>= j n)
- (format t str)
- (write form :pretty t))
- (format t str)
- (write form :pretty t)))
- (format t "~\&"))
-
- This driver routine makes it easdy to explore a large number of cases
- systematically. Here is a list of examples that illustrate not only the
- differences between , and ,@ but also their interaction with '.
-
- (setq fools2 '(
- "$$(foo %%p)"
- "$$(foo %%@q)"
- "$$(foo %'%r)"
- "$$(foo %'%@s)"
- "$$(foo %@%p)"
- "$$(foo %@%@q)"
- "$$(foo %@'%r)"
- "$$(foo %@'%@s)"
- ))
-
- Consider this set of sample values:
-
- (setq p '(union x y))
- (setq q '((union x y) (list 'sqrt 9)))
- (setq r '(union x y))
- (setq s '((union x y)))
-
- Here is what happened when I executed (try fools2 2) with a non-nil value for
- the variable *bq-simplify* (to see simplified forms). I have interpolated some
- remarks.
-
- ``(foo ,,p) = (LIST 'LIST ''FOO P)
- => (LIST 'FOO (UNION X Y))
- => (FOO (A B C))
-
- So ,,p means ``the value of p is a form; use the value of the value of p.''
-
- ``(foo ,,@q) = (LIST* 'LIST ''FOO Q)
- => (LIST 'FOO (UNION X Y) (LIST 'SQRT 9))
- => (FOO (A B C) (SQRT 9))
-
- So ,,@q means ``the value of q is a list of forms; splice the list of values of
- the elements of the value of q.''
-
- ``(foo ,',r) = (LIST 'LIST ''FOO (LIST 'QUOTE R))
- => (LIST 'FOO '(UNION X Y))
- => (FOO (UNION X Y))
-
- So ,',r means ``the value of r may be any object; use the value of r that is
- available at the time of first evaluation, that is, when the outer backquote is
- evaluated.'' (To use the value of r that is available at the time of second
- evaluation, that is, when the inner backquote is evaluated, just use ,r.)
-
- ``(foo ,',@s) = (LIST 'LIST ''FOO (CONS 'QUOTE S))
- => (LIST 'FOO '(UNION X Y))
- => (FOO (UNION X Y))
-
- So ,',@s means ``the value of s must be a singleton list of any object; use the
- element of the value of s that is available at the time of first evaluation,
- that is, when the outer backquote is evaluated.'' Note that s must be a
- singleton list because it will be spliced into a form (quote ), and the quote
- special form requires exactly one subform to appear; this is generally true of
- the sequence ',@. (To use the value of s that is available at the time of
- second evaluation, that is, when the inner backquote is evaluated, just use
- ,@s,in which case the list s is not restricted to be singleton, or ,(car s).)
-
- ``(foo ,@,p) = (LIST 'CONS ''FOO P)
- => (CONS 'FOO (UNION X Y))
- => (FOO A B C)
-
- So ,@,p means ``the value of p is a form; splice in the value of the value of
- p.''
-
- ``(foo ,@,@q) = (LIST 'CONS ''FOO (CONS 'APPEND Q))
- => (CONS 'FOO (APPEND (UNION X Y) (LIST 'SQRT 9)))
- => (FOO A B C SQRT 9)
-
- So ,@,@q means ``the value of q is a list of forms; splice each of the values
- of the elements of the value of q, so that many splicings occur.''
-
- ``(foo ,@',r) = (LIST 'CONS ''FOO (LIST 'QUOTE R))
- => (CONS 'FOO '(UNION X Y))
- => (FOO UNION X Y)
-
- So ,@',r means ``the value of r must be a list; splice in the value of r that
- is available at the time of first evaluation, that is, when the outer backquote
- is evaluated.'' (To splice the value of r that is available at the time of
- second evaluation, that is, when the inner backquote is evaluated, just use
- ,@r.)
-
- ``(foo ,@',@s) = (LIST 'CONS ''FOO (CONS 'QUOTE S))
- => (CONS 'FOO '(UNION X Y))
- => (FOO UNION X Y)
-
- So ,@',@s means ``the value of s must be a singleton list whose element is a
- list; splice in the list that is the element of the value of s that is
- available at the time of first evaluation, that is, when the outer backquote is
- evaluated.'' (To splice the element of the value of s that is available at the
- time of second evaluation, that is, when the inner backquote is evaluated, just
- use ,@(car s).)
-
- I leave it to the reader to explore the possibilities of triply nested
- backquotes.
-
- (setq fools3 '(
- "$$$(foo %%%p)" "$$$(foo %%%@q)"
- "$$$(foo %%'%r)" "$$$(foo %%'%@s)"
- "$$$(foo %%@%p)" "$$$(foo %%@%@q)"
- "$$$(foo %%@'%r)" "$$$(foo %%@'%@s)"
- "$$$(foo %'%%p)" "$$$(foo %'%%@q)"
- "$$$(foo %'%'%r)" "$$$(foo %'%'%@s)"
- "$$$(foo %'%@%p)" "$$$(foo %'%@%@q)"
- "$$$(foo %'%@'%r)" "$$$(foo %'%@'%@s)"
- "$$$(foo %@%%p)" "$$$(foo %@%%@q)"
- "$$$(foo %@%'%r)" "$$$(foo %@%'%@s)"
- "$$$(foo %@%@%p)" "$$$(foo %@%@%@q)"
- "$$$(foo %@%@'%r)" "$$$(foo %@%@'%@s)"
- "$$$(foo %@'%%p)" "$$$(foo %@'%%@q)"
- "$$$(foo %@'%'%r)" "$$$(foo %@'%'%@s)"
- "$$$(foo %@'%@%p)" "$$$(foo %@'%@%@q)"
- "$$$(foo %@'%@'%r)" "$$$(foo %@'%@'%@s)"
- ))
-
- It is a pleasant exercise to construct values for p, q, r, and s that will
- allow execution of (try fools3 3) without error.
- [change_end]
-
- -------------------------------------------------------------------------------
- [next] [up] [previous] [contents] [index]
- Next: References Up: Common Lisp the Language Previous: Discussion
- -------------------------------------------------------------------------------
-
- -------------------------------------------------------------------------------
-
- AI.Repository@cs.cmu.edu
-